home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d949.lha
/
BBBBS
/
BBBBS65.lha
/
rexx
/
bbsQUICKIN.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-08-01
|
26KB
|
1,073 lines
/* $VER: bbsQUICKIN.rexx 6.2 © 1993 Richard Lee Stockton (1.8.93)
- FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -
Processes archive "QUICKIN.lha" in user's emailfiles.
Should be made by bbsQUICK.rexx, the offline reader.
Handles incoming mail, messages, downloads, and uploads.
Also handles some sysop and super-sysop offline functions.
*/
CR='0D'x
LF='0A'x
SIGNAL ON ERROR
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
ARG name level sysoplevel accessflag .
fromcli=0
figarg='s:CONFIG.BBS'
IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
x=OPEN(f,figarg,'R')
IF x=0 THEN
DO
SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
CALL GETOUT(20)
END
lynes.=''
DO i=1 TO 31
lynes.i=READLN(f)
END
CALL CLOSE(f)
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop=WORD(lynes.2,1)
calls=WORD(lynes.31,1)
IF name='' THEN
DO
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF RIGHT(bbspath,1)~=':' & RIGHT(bbspath,1)~='/' THEN bbspath=bbspath'/'
msgpath=WORD(lynes.7,1)
IF RIGHT(msgpath,1)~=':' & RIGHT(msgpath,1)~='/' THEN msgpath=msgpath'/'
libpath=WORD(lynes.8,1)
IF RIGHT(libpath,1)~=':' & RIGHT(libpath,1)~='/' THEN libpath=libpath'/'
name=sysop
IF ~EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
DO
SAY bbspath'EmailFiles/'name'/QUICKIN.lha does not exist!'
CALL GETOUT(21)
END
level=99
sysoplevel=99
accessflag=0
fromcli=1
END
ELSE
DO
bbspath=GETCLIP('BBS_path')
msgpath=GETCLIP('BBS_msgpath')
libpath=GETCLIP('BBS_libpath')
END
/* Wait 10 mins for QUICKOUT process (started by this user) to finish */
DO i=1 TO 100 WHILE GETCLIP('BBS_'name)='QUICK'
CALL DELAY(300)
END
/* Only one QUICKIN process at a time per user */
IF GETCLIP('BBS_'name)='QUICKIN' THEN EXIT
CALL PRAGMA('P',-1)
CALL TIME('R')
CALL SETCLIP('BBS_'name,'QUICKIN')
DO i=1 WHILE GETCLIP('BBS_QUICK_WAIT')~=''
CALL DELAY(500) /* wait for main filesaves to complete */
IF TIME('E')>42000 THEN LEAVE i /* don't wait forever */
END
DO i=1
IF GETCLIP('BBS_QUICKIN'i)='' THEN /* info clip for external STOP */
DO
CALL SETCLIP('BBS_QUICKIN'i,name)
clipnum=i
LEAVE i
END
END
arcfile=bbspath'Emailfiles/'name'/QUICKIN.lha'
savefiles=0
upfiles=-1
upbytes=0
upmail=0
upmsg=''
lastm=get_last(bbspath'Numbers/LastMail')
CALL CLOSE(STDOUT)
CALL OPEN(STDOUT,bbspath'Email/'name'/BBBBS.'lastm,'W')
SAY ' Mail: 'lastm
SAY ' From: BBBBS'
SAY ' To: 'name
SAY ' Subj: QUICKIN Report'
SAY ' Date: 'DATE('W') DATE() TIME('C')
SAY LEFT('=',75,'=')
SAY 'Here is the log of your QUICKIN file processing.'
SAY STRIP(SUBSTR(SOURCELINE(1),10))
SAY
ADDRESS COMMAND 'lha -q t' arcfile
IF RC>0 THEN
DO
SAY 'QUICKIN archive is corrupt! Aborting...'
SIGNAL DONE
END
CALL MAKEDIR('RAM:QUICK')
CALL PRAGMA('D','RAM:QUICK')
ADDRESS COMMAND 'CD RAM:QUICK' LF 'lha -mN x' arcfile
SAY
CALL check_abort()
CALL do_file_requests()
CALL check_abort()
CALL do_file_deletes()
DO i=.001 TO .999 BY .001
CALL check_abort()
hdr=RIGHT(i,3)'.HDR'
IF ~EXISTS(hdr) THEN ITERATE i
txt=RIGHT(i,3)'.TXT'
x=OPEN(f,hdr,'R')
IF x=0 THEN
DO
SAY hdr 'failed to open for reading.'
ITERATE i
END
hdr.=''
DO j=1 TO 6
hdr.j=READLN(f)
END
CALL CLOSE(f)
IF LEFT(hdr.1,6)='File: ' THEN CALL do_file()
ELSE IF LEFT(hdr.1,6)=' Msg:' THEN CALL do_msg()
ELSE IF LEFT(hdr.1,6)=' Mail:' THEN CALL do_mail()
ELSE
DO
SAY
SAY hdr 'is an unknown header type!'
DO j=1 TO 6
SAY hdr.j
SAY
END
ITERATE i
END
IF WORDS(SHOWDIR('RAM:QUICK','F'))=0 THEN LEAVE i
END
IF savefiles=1 THEN
DO
x=OPEN(f,bbspath'Lists/Files','W')
IF x=0 THEN SAY bbspath'Lists/Files failed to open for writing!'
ELSE
DO
DO i=1 TO f.0
IF f.i~='' THEN CALL WRITELN(f,i f.i)
END
CALL CLOSE(f)
SAY 'Updated Lists/Files'
END
x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
IF x=0 THEN SAY bbspath'Lists/Files.ALPHA failed to open for writing!'
ELSE
DO
DO i=1 TO a.0
num=WORD(a.i,3)
IF a.i~='' & f.num~='' THEN CALL WRITELN(f,a.i)
END
CALL CLOSE(f)
SAY 'Updated Lists/Files.ALPHA'
END
IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2)
IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
END
DROP a. f. libs.
CALL check_abort()
IF EXISTS('RAM:QUICK/Files') THEN
ADDRESS COMMAND 'delete RAM:QUICK/Files ALL QUIET'
IF EXISTS('RAM:QUICK/Information') THEN
DO
IF level=99 THEN
ADDRESS COMMAND 'copy RAM:QUICK/Information/#?' bbspath'Information'
ADDRESS COMMAND 'delete RAM:QUICK/Information ALL QUIET'
END
IF EXISTS('RAM:QUICK/BBS_TEXT') THEN
DO
IF level=99 THEN
ADDRESS COMMAND 'copy RAM:QUICK/BBS_TEXT/#?' bbspath'BBS_TEXT'
ADDRESS COMMAND 'delete RAM:QUICK/BBS_TEXT ALL QUIET'
END
IF EXISTS('RAM:QUICK/rexxDoors') THEN
DO
IF level=99 THEN
ADDRESS COMMAND 'copy RAM:QUICK/rexxDoors/#?' bbspath'rexxDoors ALL'
ADDRESS COMMAND 'delete RAM:QUICK/rexxDoors ALL QUIET'
END
IF EXISTS('RAM:QUICK/REXX') THEN
DO
IF level=99 THEN
ADDRESS COMMAND 'copy RAM:QUICK/REXX/#? REXX:'
ADDRESS COMMAND 'delete RAM:QUICK/REXX ALL QUIET'
END
IF EXISTS('RAM:QUICK/S') THEN
DO
IF level=99 THEN
ADDRESS COMMAND 'copy RAM:QUICK/S/#? S:'
ADDRESS COMMAND 'delete RAM:QUICK/S ALL QUIET'
END
IF EXISTS('RAM:QUICK/C') THEN
DO
IF level=99 THEN
ADDRESS COMMAND 'copy RAM:QUICK/C/#? C:'
ADDRESS COMMAND 'delete RAM:QUICK/C ALL QUIET'
END
CALL check_abort()
IF EXISTS('RAM:QUICK/MSG') THEN
DO
IF level=99 THEN
DO
d=SHOWDIR('RAM:QUICK/MSG','F')
DO i=1 TO WORDS(d)
msg=WORD(d,i)
PARSE VAR msg 'MSG'conf'.'msgnum
IF DATATYPE(conf,'W') & DATATYPE(msgnum,'W') THEN
DO
newname=msgpath'MSG'conf'/'msgnum
IF EXISTS(newname) THEN
DO
SAY newname 'already exists!'
ITERATE i
END
x=OPEN(f,'RAM:QUICK/MSG/'msg,'R')
IF x=0 THEN ITERATE i
a=READCH(f,65000)
CALL CLOSE(f)
a='!!'SUBSTR(a,3)
x=OPEN(f,newname,'W')
IF x=0 THEN ITERATE i
CALL WRITECH(f,a)
CALL CLOSE(f)
SAY 'Un-deleted message' msgnum 'in conference' conf
END
END
END
ADDRESS COMMAND 'delete RAM:QUICK/MSG ALL QUIET'
END
SAY
CALL check_abort()
IF EXISTS('Super') THEN
DO
IF level=99 & EXISTS('Super/Super.rexx') THEN
DO
CALL PRAGMA('D','Super')
SAY 'running Super.rexx...'
CALL Super.rexx()
CALL PRAGMA('D','/')
SAY
END
CALL DELETE('Super/Super.rexx')
CALL DELETE('Super')
END
d=SHOWDIR('RAM:QUICK','F')
IF d~='' THEN
DO
SAY
SAY 'Unable to process the following files.'
SAY
DO i=1 TO WORDS(d)
SAY
dname=WORD(d,i)
SAY 'Filename:' dname
x=OPEN(f,'RAM:QUICK/'dname,'R')
IF x=0 THEN
DO
SAY dname 'failed to open for reading!'
ITERATE i
END
stuff=READCH(f,65000)
CALL CLOSE(f)
CALL WRITECH(STDOUT,stuff)
CALL DELETE('RAM:QUICK/'dname)
END
END
DONE:
CALL DELETE(arcfile)
IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
DO
oldmess=GETCLIP('BBS_MESSAGE')
IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
newmess='Your QUICKIN archive has been processed. A report is waiting in Email.'
CALL SETCLIP('BBS_MESSAGE',oldmess||newmess)
IF upfiles>0 | upmail>0 | upmsg~='' THEN
DO
CALL SETCLIP(name'_UPDATE',upfiles upbytes upmail upmsg)
upfiles=0
upbytes=0
upmail=0
upmsg=''
END
END
IF upfiles>0 | upmail>0 | upmsg~='' THEN
DO
x=OPEN(f,bbspath'Users/'name,'R')
IF x~=0 THEN
DO
data.=''
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
data.i=line
END
CALL CLOSE(f)
data.0=i-1
IF upfiles>0 THEN
DO
files=WORD(data.14,1)
bytes=WORD(data.14,3)
IF DATATYPE(files,'W') THEN upfiles=upfiles+files
IF ~DATATYPE(bytes,'W') THEN bytes=upbytes
ELSE IF fromcli THEN
DO
bytes=bytes+upbytes
files=files+1
END
data.14=upfiles 'files' bytes 'bytes.' DATE()
END
IF upmail>0 THEN
DO
mail=WORD(data.17,2)
IF DATATYPE(mail,'W') THEN upmail=upmail+mail
data.17=WORD(data.17,1) upmail WORD(data.17,3)
END
IF upmsg~='' THEN
DO
temp=data.23
data.23=''
DO i=1 TO level
msg=WORD(temp,i)
IF ~DATATYPE(msg,'W') THEN msg=0
DO j=1 TO WORDS(upmsg)
IF WORD(upmsg,j)=i THEN msg=msg+1
END
data.23=data.23 msg
END
END
x=OPEN(f,bbspath'Users/'name,'W')
IF x~=0 THEN
DO
DO i=1 TO data.0
CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User file' name 'updated.'
END
END
END
SAY 'QUICKIN archive for' name 'sucessfully processed at' TIME('C')
temp='It took'
secs=TIME('E')
mins=secs%60
hrs=mins%60
secs=secs//60
mins=mins//60
IF hrs=1 THEN temp=temp '1 hour'
ELSE IF hrs>0 THEN temp=temp hrs 'hours'
IF mins=1 THEN temp=temp '1 minute'
ELSE IF mins>0 THEN temp=temp mins 'minutes'
IF secs=1 THEN temp=temp '1 second'
ELSE IF secs>0 THEN temp=temp secs 'seconds'
temp=temp 'to process this file'
SAY ' -' temp '-'
SAY
CALL GETOUT(0)
EXIT
/* Functions */
check_abort:
t=GETCLIP('BBS_STOP_QUICKIN'clipnum)
IF t='' THEN RETURN
CALL SETCLIP('BBS_STOP_QUICKIN'clipnum)
SAY 'Aborted at' TIME('C')
IF t='DELETE' THEN
DO
CALL DELETE(arcfile)
ADDRESS COMMAND 'c:delete RAM:QUICK/#? ALL'
END
CALL GETOUT(0)
RETURN
do_file:
PARSE VAR hdr.1 'File:' filenum .'KeyWords: 'keywords
filename=WORD(hdr.2,2)
IF ~DATATYPE(filenum,'W') & ~EXISTS('Files/'filename) THEN
DO
SAY filename 'did not arrive with the QUICKIN archive!'
RETURN
END
toname=WORD(hdr.3,2)
lib=WORD(hdr.3,9)
IF load_files() THEN RETURN
IF load_alpha() THEN RETURN
CALL load_libs()
IF DATATYPE(filenum,'W') THEN
DO
IF f.filenum='' THEN
DO
SAY 'File number' filenum '['lib'/'filename'] does not exist!'
RETURN
END
PARSE VAR f.filenum oldlib' 'oldname .
IF lib='^' THEN lib=oldlib
IF filename='^' THEN filename=oldname
END
DO ii=1 TO level
IF UPPER(lib)=UPPER(libs.ii) THEN LEAVE ii
END
IF ii>level THEN
DO
SAY 'Unknown File Library:' lib 'for' filename
IF sysoplibnum=0 | DATATYPE(filenum,'W') THEN RETURN
SAY 'Placing' filename 'in Sysops library.'
lib='Sysops'
libnum=sysoplibnum
END
ELSE libnum=ii
IF DATATYPE(filenum,'W') THEN
DO
IF sysoplevel>level THEN RETURN
subpath=oldlib'/'oldname
finfo=STATEF(bbspath'FileNotes/'subpath)
x=OPEN(f,bbspath'FileNotes/'subpath,'R')
IF x=0 THEN
DO
SAY bbspath'FileNotes/'subpath 'failed to open for reading!'
RETURN
END
note.=''
DO ii=1 WHILE ~EOF(f)
note.ii=READLN(f)
END
CALL CLOSE(f)
note.0=ii
IF note.ii='' THEN note.0=ii-1
IF UPPER(lib)~=UPPER(oldlib) | UPPER(filename)~=UPPER(oldname) THEN
DO
IF EXISTS(libpath||subpath) THEN
DO
ADDRESS COMMAND 'copy' libpath||subpath libpath||lib'/'filename
CALL DELETE(libpath||subpath)
END
comm='copy' bbspath'FileNotes/'subpath
comm=comm bbspath'FileNotes/'lib'/'filename 'CLONE'
ADDRESS COMMAND comm
CALL DELETE(bbspath'FileNotes/'subpath)
IF UPPER(lib)~=UPPER(oldlib) THEN
DO
PARSE VAR note.3 front'Lib:' .
note.3=front'Lib:' lib
SAY ' Moved:' filename 'from' oldlib 'to' lib 'library.'
END
IF UPPER(filename)~=UPPER(oldname) THEN
DO
PARSE VAR note.2 'Name:' . 'Size: 'back
note.2='Name:' LEFT(filename,27)' Size: 'back
SAY 'Renamed:' oldname 'to' filename 'in the' lib 'library.'
END
f.filenum=lib filename
END
IF keywords~='^' THEN
DO
PARSE VAR note.1 front'KeyWords:' .
note.1=front'KeyWords:' keywords
SAY 'Changed: KeyWords for' lib'/'filename'.'
END
IF toname~=WORD(note.3,2) & toname~='^' THEN
DO
PARSE VAR note.3 'From: 'fromname back
note.3='From:' toname back
SAY 'Changed: Uploader of' lib'/'filename 'from' fromname 'to' toname'.'
END
num=f.filenum.0
IF DATATYPE(num,'W') THEN
DO
PARSE VAR note.1 . 'KeyWords: 'keywords
alpha=LEFT(filename,22-LENGTH(WORD(note.2,4)))
alpha=alpha WORD(note.2,4) RIGHT(filenum,5)
alpha=alpha RIGHT(libnum,2) LEFT(lib,12)
alpha=alpha STRIP(LEFT(STRIP(keywords),32))
a.num=alpha
END
DO ii=1 TO 4
hdr.ii=note.ii
END
IF EXISTS(txt) THEN
SAY 'Changed long file description for' lib'/'filename
ELSE IF note.0>4 THEN
DO
x=OPEN(f,txt,'W')
IF x=0 THEN SAY txt 'failed to open for writing!'
ELSE
DO ii=5 TO note.0
CALL WRITELN(f,note.ii)
END
CALL CLOSE(f)
CALL DELAY(14)
END
CALL write_msg(4,bbspath'FileNotes/'lib'/'filename)
END
ELSE
DO
DO ii=1 TO f.0
IF UPPER(WORD(f.ii,2))=UPPER(filename) THEN
DO
SAY filename 'is already here, in the' WORD(f.ii,1) 'library.'
RETURN
END
END
lastf=get_last(bbspath'Numbers/LastFile')
IF accessflag & sysoplevel>level THEN lib='Sysops'
ADDRESS COMMAND 'copy RAM:QUICK/Files/'filename libpath||lib
hdr.1='File:' lastf SUBSTR(hdr.1,13)
hdr.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')' Lib: 'lib
CALL write_msg(4,bbspath'FileNotes/'lib'/'filename)
f.lastf=lib filename
f.0=lastf
PARSE VAR hdr.1 . 'KeyWords: 'keywords
alpha=LEFT(filename,22-LENGTH(WORD(hdr.2,4)))
alpha=alpha WORD(hdr.2,4) RIGHT(lastf,5)
alpha=alpha RIGHT(libnum,2) LEFT(lib,12)
alpha=alpha STRIP(LEFT(STRIP(keywords),32))
DO ii=a.0 TO 1 BY -1
n=ii+1
IF STRIP(a.ii)='' THEN
DO WHILE STRIP(a.ii)='' & ii>1
ii=ii-1
END
IF UPPER(a.ii)>UPPER(alpha) THEN
DO
num=WORD(a.ii,3)
IF DATATYPE(num,'W') THEN f.num.0=n
a.n=a.ii
END
ELSE
DO
a.n=alpha
f.lastf.0=n
LEAVE ii
END
END
IF ii<1 THEN
DO
a.1=alpha
f.lastf.0=1
END
a.0=a.0+1
upfiles=upfiles+1
newbytes=
upbytes=upbytes+WORD(alpha,2)
newf=bbspath'EMail/'sysop'/NEW_FILES'
IF EXISTS(newf) THEN ok=OPEN(f,newf,'A')
ELSE
DO
ok=OPEN(f,newf,'W')
IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***')
END
IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' lib'/'filename' 'DATE() TIME() 'via QUICK')
CALL CLOSE(f)
SAY 'Uploaded' filename 'as file' lastf 'in the' lib 'library.'
IF WORD(lynes.24,1)='1' THEN CALL bbsNewFile.rexx(name libpath||lib'/'filename)
END
savefiles=1
RETURN
do_msg:
toname=WORD(hdr.3,2)
conf=WORD(hdr.5,8)
IF conf.0~='' THEN CALL load_conf()
DO ii=1 TO level
IF UPPER(conf)=UPPER(conf.ii) THEN LEAVE ii
END
IF ii>level THEN
DO
SAY 'Unknown Message Conference:' conf
RETURN
END
confnum=ii
lastm=get_last(bbspath'Numbers/LastMessage'confnum)
hdr.1=' Msg:' lastm
hdr.5=' Date:' DATE('W') DATE() TIME('C')
hdr.5=LEFT(hdr.5,39) 'Conference:' conf
replynum=WORD(hdr.3,4)
IF DATATYPE(replynum,'W') THEN
DO
x=OPEN(f,msgpath'MSG'confnum'/'replynum,'R')
IF x~=0 THEN
DO
data.=''
DO ii=1 WHILE ~EOF(f)
data.ii=READLN(f)
END
CALL CLOSE(f)
data.0=ii
IF data.ii='' THEN data.0=ii-1
IF WORDS(data.1)>3 THEN data.1=data.1 lastm
ELSE data.1=data.1' Reply' lastm
x=OPEN(f,msgpath'MSG'confnum'/'replynum,'W')
IF x~=0 THEN
DO ii=1 TO data.0
CALL WRITELN(f,data.ii)
END
CALL CLOSE(f)
END
END
IF write_msg(6,msgpath'MSG'confnum'/'lastm) THEN
DO
SAY 'Sent message' lastm 'to' toname 'in the' conf 'conference.'
upmsg=STRIP(upmsg confnum)
END
IF ~EXISTS(bbspath'Users/'toname) THEN RETURN
x=OPEN(f,bbspath'Users/'toname,'R')
IF x=0 THEN
DO
SAY bbspath'Users/'toname 'failed to open for reading.'
RETURN
END
data.=''
DO ii=1 WHILE ~EOF(f)
data.ii=READLN(f)
END
CALL CLOSE(f)
data.0=ii-1
data.24=data.24 confnum'/'lastm
x=OPEN(f,bbspath'Users/'toname,'W')
IF x=0 THEN
DO
SAY bbspath'Users/'toname 'failed to open for writing.'
RETURN
END
DO ii=1 TO data.0
CALL WRITELN(f,data.ii)
END
CALL CLOSE(f)
RETURN
do_mail:
toname=WORD(hdr.3,2)
mailpath=bbspath'Email/'toname
IF ~EXISTS(mailpath) THEN
DO
SAY mailpath 'does not exist, or failed to open! Unable to send mail.'
RETURN
END
lastm=get_last(bbspath'Numbers/LastMail')
PARSE VAR hdr.1 . 'FILE: 'emailfile .
hdr.1=' Mail:' lastm
IF emailfile~='' & EXISTS('RAM:QUICK/Files/'emailfile) THEN
hdr.1=hdr.1' FILE:' emailfile
hdr.5=' Date: 'DATE('W') DATE() TIME('C')
IF write_msg(6,mailpath'/'name'.'lastm) THEN SAY 'Sent email' lastm 'to' toname'.'
IF emailfile~='' & EXISTS('RAM:QUICK/Files/'emailfile) THEN
DO
mailfilepath=bbspath'EmailFiles/'toname
CALL MAKEDIR(mailfilepath)
ADDRESS COMMAND 'copy RAM:QUICK/Files/'emailfile mailfilepath
IF WORD(lynes.24,1)='1' THEN
CALL bbsNewFile.rexx(name 'RAM:QUICK/Files/'emailfile)
hdr.1=hdr.1' FILE:' emailfile
SAY '...with attached file;' emailfile
END
upmail=upmail+1
RETURN
write_msg:
PARSE ARG hdrstop,ofile
data=''
x=OPEN(f,txt,'R')
IF x=0 THEN
DO
IF hdrstop=6 THEN
DO
SAY txt 'failed to open for reading.'
RETURN 0
END
END
ELSE data=READCH(f,65000)
CALL CLOSE(f)
x=OPEN(f,ofile,'W')
IF x=0 THEN
DO
SAY ofile 'failed to open for writing.'
RETURN 0
END
DO ii=1 TO hdrstop
CALL WRITELN(f,hdr.ii)
END
IF data~='' THEN CALL WRITECH(f,data)
CALL CLOSE(f)
CALL DELETE(hdr)
CALL DELETE(txt)
RETURN 1
load_files:
IF DATATYPE(f.0,'W') THEN RETURN 0
f.=''
x=OPEN(f,bbspath'Lists/Files','R')
IF x=0 THEN
DO
SAY bbspath'Lists/Files failed to open for reading!'
RETURN 1
END
f.0=0
DO ii=1 WHILE ~EOF(f)
line=READLN(f)
num=WORD(line,1)
IF DATATYPE(num,'W') THEN
DO
f.num=WORD(line,2) WORD(line,3)
IF num>f.0 THEN f.0=num
END
END
CALL CLOSE(f)
RETURN 0
load_alpha:
IF DATATYPE(a.0,'W') THEN RETURN 0
a.=''
x=OPEN(f,bbspath'Lists/Files.ALPHA','R')
IF x=0 THEN
DO
SAY bbspath'Lists/Files.ALPHA failed to open for reading!'
RETURN 1
END
DO ii=1 WHILE ~EOF(f)
a.ii=READLN(f)
num=WORD(a.ii,3)
IF DATATYPE(num,'W') THEN f.num.0=ii
END
CALL CLOSE(f)
a.0=ii
DO WHILE STRIP(a.ii)=''
ii=ii-1
a.0=ii
END
RETURN 0
do_file_requests:
fr='File_Requests'
IF EXISTS(fr) THEN
DO
x=OPEN(f,fr,'R')
IF x=0 THEN
DO
SAY fr 'failed to open for reading!'
RETURN
END
fr.=''
DO i=1 WHILE ~EOF(f)
fr.i=READLN(f)
END
CALL CLOSE(f)
fr.0=i
IF fr.i='' THEN fr.0=i-1
IF load_files() THEN RETURN
selected=''
DO i=1 TO fr.0
num=fr.i
IF DATATYPE(num,'W') THEN
DO
IF f.num='' THEN
DO
SAY 'File Number' num 'does not exist!'
ITERATE i
END
subpath=WORD(f.num,1)'/'WORD(f.num,2)
finfo=STATEF(bbspath'FileNotes/'subpath)
IF finfo~='' THEN
DO
x=OPEN(f,bbspath'FileNotes/'subpath,'R')
IF x=0 THEN
DO
SAY bbspath'FileNotes/'subpath 'failed to open for reading!'
ITERATE i
END
note.=''
DO j=1 WHILE ~EOF(f)
note.j=READLN(f)
END
CALL CLOSE(f)
note.0=j
IF note.j='' THEN note.0=j-1
PARSE VAR note.2 line'Downloads: 'num .
IF DATATYPE(num,'W') THEN
DO
note.2=line'Downloads:' num+1
x=OPEN(f,bbspath'FileNotes/'subpath,'W')
IF x=0 THEN
DO
SAY bbspath'FileNotes/'subpath 'failed to open for updating!'
ITERATE i
END
DO j=1 TO note.0
CALL WRITELN(f,note.j)
END
CALL CLOSE(f)
END
ELSE
DO
SAY 'Unable to PARSE filenote' subpath 'for download count.'
SAY note.2
END
END
IF EXISTS(libpath||subpath) THEN
selected=STRIP(selected libpath||subpath)
ELSE IF WORDS(finfo)>7 THEN
DO
comment=SUBSTR(finfo,WORDINDEX(finfo,8))
IF EXISTS(comment) THEN selected=STRIP(comment selected)
END
ELSE SAY subpath 'is missing! Unable to archive for download.'
END
ELSE IF fr.i~='' THEN
SAY 'Unknown file request!' fr.i 'Unable to archive for download.'
END
SAY
SAY 'Selected file request list:'
DO i=1 TO WORDS(selected)
SAY WORD(selected,i)
END
SAY
ADDRESS AREXX bbsArcExt.rexx name selected
CALL DELETE(fr)
SAY 'File Requests have been passed to the file archiver...'
SAY
CALL DELAY(100)
END
RETURN
do_file_deletes:
fr='File_Deletes'
IF ~EXISTS(fr) THEN RETURN
x=OPEN(f,fr,'R')
IF x=0 THEN
DO
SAY fr 'failed to open for reading!'
RETURN
END
fr.=''
DO i=1 WHILE ~EOF(f)
fr.i=READLN(f)
END
CALL CLOSE(f)
fr.0=i
IF fr.i='' THEN fr.0=i-1
IF load_files() THEN RETURN
IF load_alpha() THEN RETURN
DO i=1 TO fr.0
num=fr.i
IF DATATYPE(num,'W') THEN
DO
IF f.num='' THEN
DO
SAY 'File Number' num 'does not exist to delete!'
ITERATE i
END
subpath=WORD(f.num,1)'/'WORD(f.num,2)
finfo=STATEF(bbspath'FileNotes/'subpath)
IF sysoplevel>level THEN
DO
x=OPEN(f,bbspath'FileNotes/'subpath,'R')
IF x=0 THEN
DO
SAY bbspath'FileNotes/'subpath 'failed to open for reading!'
ITERATE i
END
CALL READLN(f)
CALL READLN(f)
from=WORD(READLN(f),2)
CALL CLOSE(f)
IF name~=from THEN
DO
SAY subpath 'not deleted.'
SAY 'You may only delete files you have uploaded yourself.'
ITERATE i
END
END
IF EXISTS(libpath||subpath) THEN
DO
IF DELETE(libpath||subpath)=0 THEN
SAY 'Failed to delete' libpath||subpath
END
ELSE IF WORDS(finfo)>7 THEN
DO
comment=SUBSTR(finfo,WORDINDEX(finfo,8))
IF EXISTS(comment) THEN
IF DELETE(comment)=0 THEN SAY 'Failed to delete' comment
END
ELSE SAY subpath 'is missing! Unable to delete.'
IF DELETE(bbspath'FileNotes/'subpath)=0 THEN
SAY 'Failed to delete' bbspath'FileNotes/'subpath
f.num=''
anum=f.num.0
IF DATATYPE(anum,'W') THEN a.anum=''
savefiles=1
SAY 'Deleted' subpath', file number' num'.'
END
ELSE IF STRIP(fr.i)~='' THEN SAY 'Unknown delete request!' fr.i
END
SAY
CALL DELETE(fr)
RETURN
load_libs:
IF libs.0='' THEN RETURN
sysoplibnum=0
libs.=''
x=OPEN(f,bbspath'Lists/Libraries','R')
IF x=0 THEN
DO
SAY bbspath'Lists/Libraries failed to open for reading!'
CALL GETOUT(0)
END
DO ii=1
line=READLN(f)
IF EOF(f) | line='END' THEN LEAVE ii
num=WORD(line,1)
IF DATATYPE(num,'W') THEN
DO
num=num%1
IF num>0 & num<100 THEN
DO
libs.num=WORD(line,2)
IF UPPER(libs.num)='SYSOPS' THEN sysopslibnum=num
END
END
END
CALL CLOSE(f)
RETURN
load_conf:
conf.=''
x=OPEN(f,bbspath'Lists/Conferences','R')
IF x=0 THEN
DO
SAY bbspath'Lists/Conferences failed to open for reading!'
CALL GETOUT(0)
END
conf.=''
DO ii=1
line=READLN(f)
IF EOF(f) | line='END' THEN LEAVE ii
num=WORD(line,1)
IF DATATYPE(num,'W') THEN
DO
num=num%1
IF num>0 & num<100 THEN conf.num=WORD(line,2)
END
END
CALL CLOSE(f)
RETURN
do_user_change:
uc='User_Changes'
IF ~EXISTS(uc) THEN RETURN
x=OPEN(f,uc,'R')
IF x=0 THEN
DO
SAY uc 'failed to open for reading!'
RETURN
END
uc.=''
DO i=1 WHILE ~EOF(f)
uc.i=READLN(f)
END
CALL CLOSE(f)
uc.0=i
IF uc.i='' THEN uc.0=i-1
DO i=1 TO uc.0
PARSE VAR uc.i uname mins lev exc
x=OPEN(f,bbspath'Users/'uname,'R')
IF x=0 THEN
DO
SAY uname 'does not appear to be a member of' bbsname
ITERATE i
END
DO j=1
line=READLN(f)
IF EOF(f) THEN LEAVE j
data.j=line
END
CALL CLOSE(f)
data.0=j-1
IF DATATYPE(mins,'W') THEN data.11=mins 'minutes' calls 'more times today.'
IF DATATYPE(lev,'W') THEN data.20=lev
IF STRIP(exc)~='' THEN data.21=exc
x=OPEN(f,bbspath'Users/'uname,'W')
IF x=0 THEN
DO
SAY uname 'did not open for writing!'
ITERATE i
END
DO j=1 TO data.0
CALL WRITELN(f,data.j)
END
CALL CLOSE(f)
END
CALL DELETE(uc)
RETURN
get_last:
PARSE ARG statname
x=OPEN(f,statname,'R')
IF x=0 THEN
DO
SAY statname 'failed to open for reading!'
RETURN 0
END
last=READLN(f)
CALL CLOSE(f)
IF DATATYPE(last,'W') THEN last=last+1
ELSE RETURN 0
OPTIONS FAILAT 20
ADDRESS COMMAND 'ECHO >'statname last
RETURN last
GETOUT:
ARG err
IF err>0 THEN SAY 'Error:' err' RC='RC' SIGL='SIGL
ERROR:
SYNTAX:
FAILURE:
IF RC>0 THEN SAY 'RC='RC' SIGL='SIGL
IF GETCLIP('BBS_'name)='QUICKIN' THEN CALL SETCLIP('BBS_'name)
CALL SETCLIP('BBS_QUICKIN'clipnum)
EXIT err
/* bbsQUICKIN.rexx */